home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Eagles Nest BBS 8
/
Eagles_Nest_Mac_Collection_Disc_8.TOAST
/
Developer Tools⁄Additions
/
InsideBa1994
/
InsideBasic-94
/
IB 94
/
After Dark
/
Bouncing Ball.bas
next >
Wrap
BASIC Source File
|
1993-04-10
|
14KB
|
356 lines
'Generic After Dark module
'Written by Jonathan E. Durkee
RESOURCES "Bouncing Ball.res", "ADgmADrk", "ADgm", 0, "BallBounce", _resPurgeable _resSysHeap
COMPILE 0, _sysHeapVars _pointerVars
OUTPUT FILE "Bouncing Ball/FB"
'*****************define variables constants & globals*************
DIM RECORD monitorData
DIM monitorRect.8
DIM synchFlag%
DIM curDepth%
DIM END RECORD.monitorData
DIM RECORD MonitorsInfo
DIM monitorCount%
DIM monitorList.monitorData
DIM END RECORD.MonitorsInfo
DIM RECORD ctrlArray
DIM item1%
DIM item2%
DIM item3%
DIM item4%
DIM END RECORD.ctrlArray
'The array of controls in the AD control panel
DIM RECORD qdGlobals
DIM qdThePort&
DIM qdWhite.8
DIM qdBlack.8
DIM qdGray.8
DIM qdLtGray.8
DIM qdDkGray.8
DIM qdArrow.16
DIM qdScreenBits&
DIM qdRandSeed&
DIM END RECORD.qdGlobals
DIM RECORD GMParamBlockRec
DIM controlValues.ctrlArray 'var for control values
DIM monitors& 'handle for monitor data
DIM colorQDAvail% 'is color quickdraw available?
DIM systemConfig% 'system configuration bytes
DIM qdGlobalsCopy& 'pointer to quickdraw globals
DIM brightness% 'field for storing screen brightness value
DIM demoRect.8 'rect of "Demo" window in AD control panel
DIM errorMessage& 'handle to field for error message
DIM sndChannel& 'channel for sound playing
DIM adVersion% 'after dark version
DIM END RECORD.GMParamBlockRec
'That's the Main Param Block Record. Got all sorts of interesting
'info.
'Messages passed to the module by After Dark
_initialize=0
_moduleClose=1
_blank=2
_drawFrame=3
_moduleSelected=4
_doHelp=5
_chooseColorButton=9
'Messages passed to After Dark by the module
_moduleError=-1
_noProblem=0
_restartMe=1
_imDone=2
_refreshResources=3
'Other constants needed by the program
_resID=128 'resource ID for the RGBv resource
_minValue=3 'minimum speed for ball, also minimum size
DIM ballRect.8 'the ball's position
DIM ballColor.6 'ball's color
DIM ballH%,ballV% 'horz & vert velocities
DIM ballDirH%,ballDirV% 'these two are always 1 or -1 for the direction of ball's movement
DIM oldBallRgn&,newBallRgn&,trailingRgn&'regions used to draw the ball
END GLOBALS 'all done with global vars & constants
'*****************Useful, transportable functions here*************
CLEAR LOCAL MODE
DIM tempPramBlock.GMParamBlockRec
LOCAL FN mainMonitorDepth(paramBlockPtr&)
BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
LONG IF tempPramBlock.colorQDAvail%
'do we have color quickdraw? if so then find the color depth.
colorDepth=PEEK WORD(PEEK LONG(PEEK LONG(PEEK LONG(FN GETMAINDEVICE)+22))+32)
XELSE
'if there's no color quickdraw, bit depth is always going to be 1.
colorDepth=1
END IF
END FN=colorDepth
CLEAR LOCAL MODE
DIM tempPramBlock.GMParamBlockRec
DIM tempMonitorBlock.monitorsInfo
LOCAL FN mainMonitorH(paramBlockPtr&)
BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
BLOCKMOVE tempPramBlock.monitors&,@tempMonitorBlock,_monitorsInfo
END FN=tempMonitorBlock.monitorList.monitorRect.right%
CLEAR LOCAL MODE
DIM tempPramBlock.GMParamBlockRec
DIM tempMonitorBlock.monitorsInfo
LOCAL FN mainMonitorV(paramBlockPtr&)
BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
BLOCKMOVE tempPramBlock.monitors&,@tempMonitorBlock,_monitorsInfo
END FN=tempMonitorBlock.monitorList.monitorRect.bottom%
CLEAR LOCAL MODE
LOCAL FN setDirection(direction%,variable%)
'Use this function if you have a velocity of unknown direction, and you want
'to set it to a known direction. (not used in Bouncing Ball - here for your convenience only)
LONG IF direction%=-1
IF variable%<0 THEN nuVelocity%=variable%'leave it alone
IF variable%>0 THEN nuVelocity%=variable%*-1'flip it the other way
END IF
LONG IF direction%=1
IF variable%<0 THEN nuVelocity%=variable%*-1
IF variable%>0 THEN nuVelocity%=variable%
END IF
'if direction% was not =1 or =-1, we ignore it - must have been a syntax error.
END FN=nuVelocity%
CLEAR LOCAL MODE
'use this function to report a problem to After Dark when your module can't run
DIM tempPramBlock.GMParamBlockRec
LOCAL FN errorMessage(paramBlockPtr&,complaint$)
BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
BLOCKMOVE @complaint$, tempPramBlock.errorMessage&, LEN(complaint$)+1
END FN
'************Bouncing Ball-specific functions*******************
CLEAR LOCAL
LOCAL FN newSpeeds(totalSpeed%)
'This function sets up two new speeds. The sum of the two is equal to whatever
'the user selected in the control panel as the ball's speed.
'IF totalSpeed%<2 THEN totalSpeed%=2 'don't give impossibly small values
ballH%=RND(totalSpeed%)
ballV%=totalSpeed%-ballH%
END FN
CLEAR LOCAL MODE
LOCAL FN slider(controlPanelValue%)
'This function is used whenever data is needed from one of the two control panel sliders.
'It simply makes sure that the value is not lower than a minimum value set as a constant.
IF controlPanelValue%<_minValue THEN realValue%=_minValue ELSE realValue%=controlPanelValue%
END FN=realValue%
CLEAR LOCAL
LOCAL FN tweekSpeeds(newSpeed%)
oldSpeed%=ballH%+ballV%
'figure out what the old control panel value was
diff%=newSpeed%-oldSpeed%
splitDiff%=diff%/2
ballH%=ballH%+splitDiff%
ballV%=newSpeed%-ballH%
'This function is used whenever the user changes control panel values and our module
'is running (only happens in demo mode). What it does is to change the ball speeds so
'that the ball travels in (nearly) the same direction, but at a rate proportional to
'the new Control Panel slider value.
END FN
CLEAR LOCAL
DIM tempPramBlock.GMParamBlockRec
LOCAL FN doInitialize(storage&,blankrgn&,paramblockptr&)
result%=_noProblem
storage&=FN NEWHANDLE(2)
'allocate a new handle of two bytes. We won't use this handle - it's just
'there to keep After Dark from panicking and thinking the module had a
'problem while initializing. (After Dark doesn't like nil handles any more than you do.)
BLOCKMOVE paramblockptr&,@tempPramBlock,_GMParamBlockRec
'get the parameter block into tempPramBlock
LONG IF storage&<>0
'let's set up variables, etc.
oldBallRgn&=FN NEWRGN:newBallRgn&=FN NEWRGN:trailingRgn&=FN NEWRGN
'create new regions, to be used when drawing the ball
LONG IF oldBallRgn&<>0 AND newBallRgn&<>0 AND trailingRgn&<>0
'now set up some random values for the ball to start with
ballRect.top%=RND(FN mainMonitorV(paramblockptr&))
ballRect.left%=RND(FN mainMonitorH(paramblockptr&))
ballRect.bottom%=ballRect.top%+tempPramBlock.controlValues.item1%
ballRect.right%=ballRect.left%+tempPramBlock.controlValues.item1%
'make a randomly positioned rectangle on the main monitor, set to the size
'requested by the user
FN newSpeeds(tempPramBlock.controlValues.item2%)
IF RND(2)=1 THEN ballDirH%=1 ELSE ballDirH%=-1
IF RND(2)=1 THEN ballDirV%=1 ELSE ballDirV%=-1
'Set up random directions for the ball to drift in
XELSE
result%=_moduleError
FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not get enough memory.")
END IF
XELSE
result%=_moduleError
FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, an error occured while allocating memory.")
'Whoops, no memory available. Close module & give an error message.
END IF
END FN=result%
CLEAR LOCAL
DIM tempPramBlock.GMParamBlockRec
LOCAL FN doBlank(blankrgn&,paramblockptr&)
BLOCKMOVE paramblockptr&,@tempPramBlock,_GMParamBlockRec
'first get the ball's RGB color value from the "RGBv" resource. The reason we are
'doing this here instead of in FN doInitialize is because the user may have changed the
'color since the last time the module activated.
resHndl&=FN GETRESOURCE(_"RGBv",_resID)
LONG IF resHndl&<>0
BLOCKMOVE [resHndl&],@ballColor,_RGBColor
CALL RELEASERESOURCE(resHndl&) 'trash the resource handle
'move an RGBColor record into ballColor from the resource
XELSE
result%=_moduleError
'We couldn't load the Ball Color resource in, so post an error message
'and cancel the program.
FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not load a necessary resource.")
END IF
CALL PAINTRGN(blankrgn&)
LONG IF tempPramBlock.colorQDAvail%<>_false
CALL RGBFORECOLOR(ballColor.red%)
XELSE
CALL PENMODE(_srcXor)
END IF
CALL PAINTOVAL(ballRect)
END FN=_noProblem 'no problems possible in this function
LOCAL FN doClose(storage&,blankrgn&,paramblockptr&)
'All that needs to be done here is to dispose of the handle allocated in doInitialize,
CALL DISPOSERGN(oldBallRgn&):CALL DISPOSERGN(newBallRgn&):CALL DISPOSERGN(trailingRgn&)
'and to dispose of the regions.
END FN=FN DISPOSHANDLE(storage&)
CLEAR LOCAL
DIM tempPramBlock.GMParamBlockRec
DIM newPosition.8
DIM blackColor.RGBColor
LOCAL FN drawFrame(blankRgn&,paramBlock&)
result%=_noProblem:CALL PENNORMAL
BLOCKMOVE @ballRect,@newPosition,8
BLOCKMOVE paramBlock&,@tempPramBlock,_GMParamBlockRec
'copy old position to new
CALL OFFSETRECT(newPosition,ballH%*ballDirH%,ballV%*ballDirV%)
'multiply the absolute speed times the direction to get the offset amount
LONG IF newPosition.bottom%-newPosition.top%<>FN slider(tempPramBlock.controlValues.item1%)
'basically this is asking if the slider for "ball size" has changed since last check
newPosition.bottom%=newPosition.top%+FN slider(tempPramBlock.controlValues.item1%)
newPosition.right%=newPosition.left%+FN slider(tempPramBlock.controlValues.item1%)
END IF
LONG IF ballH%+ballV%<>FN slider(tempPramBlock.controlValues.item2%)
'has the user changed ball speed since we last checked? if so, we must speed
'up or slow down the ball accordingly.
FN tweekSpeeds(FN slider(tempPramBlock.controlValues.item2%))
END IF
'This next part might be a bit confusing. If you don't understand it, it's just a method
'of reducing flicker. What we do is to calculate a region, which is the exact area of
'the old ball that is not covered by the new. We black only that part out, then draw
'the new ball.
CALL PENMODE(_srcCopy)
CALL OPENRGN
CALL FRAMEOVAL(ballRect.top%)
CALL CLOSERGN(oldBallRgn&)
CALL OPENRGN
CALL FRAMEOVAL(newPosition.top%)
CALL CLOSERGN(newBallRgn&)
'Now we have two regions, one for each ball position. Next calculate the difference:
CALL DIFFRGN(oldBallRgn&,newBallRgn&,trailingRgn&)
'blank out whatever part of the old region is not going to be used in the new
'now draw the new ball - depending on whether the machine is in color or not
LONG IF FN mainMonitorDepth(paramBlock&)>1
'are we in color mode? if so then draw the ball in color
CALL RGBFORECOLOR(blackColor.red%)
'this is a trick done by the CLEAR LOCAL at the beginning of this FN.
'since blackColor is cleared to all zeros, it automatically equals black. so
'we don't have to worry about putting values into it.
CALL PAINTRGN(trailingRgn&)
CALL RGBFORECOLOR(ballColor.red%)
CALL PAINTRGN(newBallRgn&)
XELSE
CALL PAINTRGN(trailingRgn&)
CALL ERASERGN(newBallRgn&)
END IF
BLOCKMOVE @newPosition,@ballRect,8
'move the new position back into the old
'now check to make sure that the ball is not off the screen - if it is, change its direction
changedFlag%=_false
IF ballRect.top%<blankRgn&..rgnBbox.top% THEN ballDirV%=1:changedFlag%=_true
IF ballRect.bottom%>blankRgn&..rgnBbox.bottom% THEN ballDirV%=-1:changedFlag%=_true
IF ballRect.left%<blankRgn&..rgnBbox.left% THEN ballDirH%=1:changedFlag%=_true
IF ballRect.right%>blankRgn&..rgnBbox.right% THEN ballDirH%=-1:changedFlag%=_true
IF changedFlag=_true THEN FN newSpeeds(FN slider(tempPramBlock.controlValues.item2%))
'if the ball hit the wall, then change the proportion of horizontal to vertical speed
END FN=result%
CLEAR LOCAL
DIM dialogPoint.4
DIM newColor.RGBColor
DIM oldColor.RGBColor
LOCAL FN chooseColor(paramblockptr&)
result%=_noProblem
resHndl&=FN GETRESOURCE(_"RGBv",_resID)
LONG IF resHndl&<>0
BLOCKMOVE [resHndl&],@oldColor,_RGBColor
'move an RGBColor record into oldColor from the resource
CALL SETPT(dialogPoint,125,75)
'set the point where the color picker should go
colorPicked%=FN GETCOLOR(dialogPoint,"Pick a color for the ball:",oldColor,newColor)
LONG IF colorPicked% '
'Did the user pick a new color or just cancel?
'If there was a new color, let's save it to disk.
BLOCKMOVE @newColor,[resHndl&],_RGBColor
CALL CHANGEDRESOURCE(resHndl&)
'move the color into the resource & save to disk
XELSE
'user cancelled dialog so we do nothing
END IF
CALL RELEASERESOURCE(resHndl&)
'close the resource & free up memory again
XELSE
result%=_moduleError
'We couldn't load the Ball Color resource in, so post an error message
'and cancel the program.
FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not load a necessary resource.")
END IF
END FN=result%
'********************Here's the main program*****************
ENTERPROC% (StorageHndl&, BlankRgn&, Message%, ParamBlock&)
SELECT Message%
'Which message was received by the module?
CASE _initialize
result=FN doInitialize(StorageHndl&,BlankRgn&,ParamBlock&)
CASE _moduleClose
result=FN doClose(StorageHndl&,BlankRgn&,ParamBlock&)
CASE _blank
result=FN doBlank(BlankRgn&,ParamBlock&)
CASE _drawFrame
result=FN drawFrame(BlankRgn&,ParamBlock&)
CASE _moduleSelected
CASE _doHelp
CASE _chooseColorButton
result=FN chooseColor(ParamBlock&)
END SELECT
EXITPROC%=result
RETURN